home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 20 / Cream of the Crop 20 (Terry Blount) (1996).iso / image / savers_.zip / FADER.PAS < prev    next >
Pascal/Delphi Source File  |  1996-05-29  |  4KB  |  154 lines
  1. program Fader;
  2.  
  3. (* The following 3 lines are not comments. *)
  4.  
  5. {$N-,E-,Q-,S-,R-,I-,O-,F-,P+,T-,X-,V-,B-,A+,G-,D-,L-,Y-}
  6. {$M 8192,0,65536}
  7. {$L Bgi256}  (* <──── Links the graphics object file (into the code segment). *)
  8.  
  9. (* Compiled in Borland Turbo Pascal 7.0 for DOS. Bgi256.Obj is a non-Borland
  10.    aftermarket add-on file. It is "registered", meaning the Bgi256.Obj file
  11.    itself isn't needed to run Fader.exe. *)
  12.  
  13. uses crt,drivers,graph;
  14.  
  15. var
  16. Gd, Gm, Error : integer;
  17. Red, Green, Blue, TimeValue, ColorValue : shortint;
  18. Adjuster : char;
  19.  
  20. label Start;
  21.  
  22. (* Gm := 0 is 320x200x256, 1 is 640x400x256, 2 is 640x480x256,
  23.          3 is 800x600x256, 4 is 1024x768x256, 5 is 1280x1024x256 *)
  24.  
  25. procedure Bgi256proc; external; (* The "public" name as declared by BinObj.exe *)
  26.  
  27. procedure InitBgi256;
  28. begin
  29. Gd := installuserdriver('Bgi256',nil);
  30. Error := registerbgidriver(@Bgi256proc);
  31. Gm := 0;  (* Run in 320x200x256 mode *)
  32. initgraph(Gd,Gm,'');
  33. Error := graphresult;
  34. if Error <> 0 then
  35. begin
  36. closegraph;
  37. textcolor(7);
  38. textbackground(0);
  39. clrscr;
  40. textcolor(9);
  41. gotoxy(1,3);
  42. writeln(' Sorry, your display and/or video card is incompatible');
  43. writeln(' with this screen saver program. Oh, well; No harm done.');
  44. writeln;
  45. halt(1);
  46. end;
  47. end;
  48.  
  49. procedure Exit_Program;
  50. begin
  51. closegraph;
  52. textcolor(7);
  53. textbackground(0);
  54. clrscr;
  55. gotoxy(1,3);
  56. textcolor(9);
  57. write('I hope you like playing this screen saver; Fader.....');
  58. textcolor(137);
  59. writeln('.');
  60. textcolor(1);
  61. writeln('"Mission Control" was here.');
  62. donesyserror;
  63. halt;
  64. end;
  65.  
  66. begin
  67. initsyserror;   (* Turns off ctrl-break, in drivers unit. *)
  68. textcolor(1);
  69. textbackground(3);
  70. clrscr;
  71. gotoxy(1,4);
  72. write('  Welcome to Fader');
  73. textcolor(129);
  74. writeln('!');
  75. textcolor(1);
  76. writeln('  This program is a simple screen saver. What it does is put up one of up to');
  77. writeln('  262,144 colors for a tiny fraction of a second before slightly changing into');
  78. writeln('  a different hue. The effect is of the screen fading smoothly from color to');
  79. writeln('  color, each of them very pretty. There are 10 speeds in all, with 0 being the');
  80. writeln('  fastest and 9 being the slowest. While it''s playing, you may press a lower');
  81. writeln('  number to speed it up, or press a higher number to slow it down. If you want');
  82. writeln('  to re-randomize the colors, and the timimg, press the R key (for Randomize).');
  83. writeln('  This resets the colors and timing at random. This can change a boring color.');
  84. writeln('  All other keys will exit the program, either from here or from within Fader.');
  85. write('  Press a key now, either R, or from 0 through 9 to begin the fader. Enjoy....');
  86. Adjuster := readkey;
  87.  
  88. case Adjuster of
  89. '0' : TimeValue :=  0;      (* Dummy assignment, only allows 0 key to get in. *)
  90. '1' : TimeValue :=  2;
  91. '2' : TimeValue :=  5;
  92. '3' : TimeValue :=  8;
  93. '4' : TimeValue := 11;
  94. '5' : TimeValue := 14;
  95. '6' : TimeValue := 17;
  96. '7' : TimeValue := 20;
  97. '8' : TimeValue := 23;
  98. '9' : TimeValue := 26;
  99. 'r','R' : ColorValue := 0;  (* Dummy assignment, only allows R key to get in. *)
  100. else Exit_Program;
  101. end;
  102.  
  103. InitBgi256;
  104. randomize;
  105. Red:=random(64); Green:=random(64); Blue:=random(64);
  106.  
  107. Start:   (* Rapidly cycling loop. *)
  108. repeat   (* Begin loop. *)
  109. setrgbpalette(0, Red, Green, Blue);
  110.  
  111. if Adjuster <> '0' then
  112. begin
  113. if (Adjuster = 'r') or (Adjuster = 'R') then delay(random(27))
  114. else delay(TimeValue);
  115. end;
  116. if (TimeValue <> 0) or (Adjuster = 'r') or (Adjuster = 'R') then delay(1);
  117.  
  118. ColorValue := random(9);
  119. case ColorValue of
  120. 0 : Red := Red - 1;
  121. 2 : Red := Red + 1;
  122. 3 : Green := Green - 1;
  123. 5 : Green := Green + 1;
  124. 6 : Blue := Blue - 1;
  125. 8 : Blue := Blue + 1
  126. end;
  127.  
  128. if Red = -1 then Red := 1;
  129. if Red = 64 then Red := 63;
  130. if Green = -1 then Green := 1;
  131. if Green = 64 then Green := 63;
  132. if Blue = -1 then Blue := 1;
  133. if Blue = 64 then Blue := 63;
  134. until keypressed; (* End loop. *)
  135.  
  136. Adjuster := readkey;
  137. case Adjuster of
  138. '0' : TimeValue :=  0;  (* Dummy assignment, only allows 0 key to work. *)
  139. '1' : TimeValue :=  2;
  140. '2' : TimeValue :=  5;
  141. '3' : TimeValue :=  8;
  142. '4' : TimeValue := 11;
  143. '5' : TimeValue := 14;
  144. '6' : TimeValue := 17;
  145. '7' : TimeValue := 20;
  146. '8' : TimeValue := 23;
  147. '9' : TimeValue := 26;
  148. 'r','R' : begin Red:=random(64); Green:=random(64); Blue:=random(64); end;
  149. else Exit_Program;
  150. end;
  151.  
  152. goto Start;
  153.  
  154. end.